#!/usr/local/bin/perl
print "Content-type: text/html\n\n";
$param = "addusers";
print qq~
Delete survey
~;
#
sub getpassword
{
my $password;
open(INI, "../checks/account.ini");
flock(INI, 1);
while()
{
if($_ =~ 'PASSWORD')
{
chomp;
my $fieldname, $password = split(/=/, $_);
}
}
close(INI);
return $password;
}# end getpassword
sub candelete
{
# adds '=' so it won't match regular project names
my $projectname = $_[0].'=';
my @projectfiles;
my $linestoread;
my $linesread=0;
#print"projectnametopsub= ".$projectname;
#print"
";
open(USRDEL, "<../checks/useruploads.record");
while()
{
if($_ =~ /^$projectname/)
{
#print"match = ".$projectname;
#print"
";
$index = index($_, '=');
$index = $index + 1;
$linestoread = substr($_, $index);
next;
}
if($linestoread >0 && $linesread < $linestoread)
{
#print "matchingfile = ".$_;
#print"
";
unshift(@projectfiles, $_);
$linesread++;
}
}
close(USRDEL);
return @projectfiles;
} # end sub candelete();
sub rewrite
{
#takes in $projectname.ini, returns $projectname.ini
my $projectname = $_[0]."=";
#print"projectnametorewrite= ".$projectname;
#print"
";
my $linestoread = 0;
my $linesread = 0;
open(USRTEMP, ">../checks/useruploads.temp");
open(USRDEL, "<../checks/useruploads.record");
flock(USRTEMP,2);
flock(USRDEL,2);
while()
{
if($_ =~ /^$projectname/)
{
#print"main if: ".$projectname;
#print"
";
my $index = index($_, '=');
$index = $index + 1;
$linestoread = substr($_, $index);
#print"main: linestoread =".$linestoread;
next;
}
if($linestoread > 0 && $linesread < $linestoread)
{
#print"if1: linesread = ".$linesread;
#print"
";
$linesread++;
next;
}
if(linesread > $linestoread)
{
#print"if2: linesread = ".$linesread;
#print"
";
$linesread=0;
next;
}
if(linesread == 0)
{
#print"if3(0): linesread = ".$linesread;
#print"
";
print USRTEMP "$_";
next;
}
}
close(USRTEMP);
close(USRDEL);
#returns $projectname (as submitted) or return 0 = did not find entries to delete.
if($linestoread == 0)
{
return '0';
}
else
{
return substr($projectname,0,-1);
}
}#end sub rewrite
sub renamerecord
{
rename("../checks/useruploads.record", "../checks/useruploads.last");
rename("../checks/useruploads.temp", "../checks/useruploads.record");
}#end bud renamerecord
my $localpath = $ENV{HTTP_HOST};
#my $password= getpassword();
my $accountname = substr($localpath, 0, -19);
#querystring has just the project name
my $projectname = $ENV{'QUERY_STRING'}.".ini";
my @deletecandidates = candelete($projectname);
if(@deletecandidates eq '')
{
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
exit;
}
my $archivename = "archive_".substr($projectname, 0, -4).".asc";
#if the user project can be deleted, archive the data
if(@deletecandidates > 0)
{
#print"insidedeletecandidates";
my $oldname = substr($projectname, 0, -4).".asc";
if(my $arc = link($oldname, $archivename))
{
open (USRUPL, ">>../checks/files.record");
flock(USRUPL,2);
print USRUPL "\n$archivename";
close (USRUPL);
}
my $oldproject = rewrite($projectname);
renamerecord();
$projectnameonly= substr($projectname, 0, -4);
foreach(@deletecandidates)
{
chomp;
#print"unlinkfile = ".
unlink($_);
#print "file deleted = ".$_;
#print "
";
}
if(-d $projectnameonly)
{
#print"
iswriteable".(-w $projectnameonly);
#print"
projectnameonly=".$projectnameonly;
#print"
unlink the files in the project directory: ".
unlink<$projectnameonly/*>;
#print"
rmdir project directory: ".
rmdir($projectnameonly);
}
print "";
print "If Your browser does not support META refresh. Return to Survey Administration page";
}
else
{
print "";
print "If your browser does not support META refresh. Return to Survey Administration page";
}